MATCH1.NEW[1,JRA] - www.SailDart.org

perm filename MATCH1.NEW[1,JRA] blob sn#027880 filedate 1973-03-02 generic text, type T, neo UTF8

00100	
00200	
00300	(DEFPROP MATCH1 
00400	 (LAMBDA(X Y FL)
00500	  (COND ((ATOM X)
00600		 (COND ((EQ X (QUOTE %NG)) (COND ((ISLIT FL) (NEG Y)) ((ISCL FL) (MATCHPN Y T)) (T (ERR NIL))))
00700		       ((EQ X (QUOTE %PL)) (COND ((ISLIT FL) (NOT (NEG Y))) ((ISCL FL) (MATCHPN Y NIL)) (T (ERR NIL))))
00800		       ((NUMBERP X) (COND ((ISCLS FL) (MATCHTR X Y)) (T (MATMLT X Y FL))))
00900		       ((AND (MEMQ X (QUOTE (C1 C2))) (ISCLS FL)) (MEMQ (EVAL X) Y))
01000		       (T (ERR NIL))))
01100		((NUMBERP (CAR X)) (COND ((ISCLS FL) (MATCHTR (CAR X) Y)) (T (MATMLT (CAR X) Y FL))))
01200		((EQ (LENGTH X) 1) (MATMLT (CAR X) Y FL))
01300		((ISCLS FL) (COND ((EQ (CAR X) (QUOTE CL)) (MATCHTR (CADR X) Y)) (T NIL)))
01400		(T (MATMLT* X Y FL)))) 
01500	EXPR)